Internet Info 1993/Internet Info CD-ROM (Walnut Creek) (1993).iso/networking/terms/kermit/d/cray.cft

Text File | 1988-08-16 | 97.6 KB | 2,618 lines

!-cr.filing-!
      subroutine makedata(seq, result)
      implicit integer(a-z)
      ! Function : This routine is called from the SEND state to make
      !            a new 'D' packet. It gets file data from the character
      !            buffer, calling the virtual disk read routine BUFIN
      !            whenever the buffer is empty. Logical Rtne. BUFIN
      !            evaluates .false. iff a disk read fails; it sets
      !            its second argument .true. iff the current buffer
      !            contains the EOF indicator. Makedata converts CTSS
      !            EOL characters to quoted CR,LF sequences, and other
      !            embedded file control characters to the standard
      !            Kermit quoted/controlified sequences.
      !  Called Procedures : bufin, errorpkt, kctl, kchar

      parameter( full = 0, lastpkt = 1, nopkt = 3, err = 4)
      parameter( US = 037b, FS = 034b, SOH = 1, CR=13, LF=10)
      parameter( px = 1, ok = 0 )
      parameter( rpmax = 94, cutoff = 4 )
      logical bufin, last, lastbuf, debug, native, quote8, repeat

      character *504 buffer
      character *104 packet(2)
      character cmdstr*80, report*40
      character kchar, cksum, quote, kctl, pchar, old
      character eolseq*4, pktseq*6
      character*9 myparms, hisparms, defaults

      common /packets/ packet
      common /buffers/ buffer
      common /pkstats/  bptr, bufhold, maxpack, lastbuf, rpcount
      common /runparms/ myparms, hisparms, defaults
      common /strings/ cmdstr, report
      common /environ/ debug, native, quote8, repeat

      pkptr = 5                          !  pt to 1st data char in pkt
      quote = myparms(6:6)             !  quote char to send
      eolseq = quote//kctl(char(CR))
     !         // quote // kctl(char(LF))
      if (rpcount.gt.0) then             ! remnant left from last pkt
        old = buffer(bptr-1:bptr-1)      !  repeated char for comparison
      end if

10    continue                           !  top of packing loop
      if (bptr.gt.bufhold)  then         !  buffer empty
        if (rpcount.gt.0) then           !  we are in a run
          ! Truncate run at end of buffer
          bptr = bptr - 1                !  index last char of run
          go to 100                      !  put remnant in pkt first
        else if (.not.(lastbuf))then     !  there's file data left
          !  use next test to force evaluation of read fn :
          if (.not.(bufin(buffer,last))) then
            report = 'file read error.'
            result = err
            go to 900                    !  exit with the bad news
          else if (last) then            !  this evaluation got last chunk
            lastbuf = .true.             !  remember this
          end if
        else if (pkptr.gt.5) then        !  final packet a shorty
          result = lastpkt
          go to 400                      !  go polish it off now
        else                             !  starting pkt - no data to pack
          result = nopkt
          go to 900                      !  go return with this news now
        end if
      end if                             !  if buffer empty
      pchar = buffer(bptr:bptr)          !  get next buffer char
      if (repeat)  then                  !  we're doing repeat prefixing
        if (rpcount.eq.0) then           !  start a new scope
          old = pchar
          rpcount = 1
          bptr = bptr + 1
          go to 10                       !  go get next data character
        else if (pchar.eq.old) then      !  old scope continues
          rpcount = rpcount + 1
          if (rpcount.lt.rpmax) then
            bptr = bptr + 1
            go to 10
          end if                         !  else truncate here
        else                             !  pchar ends old scope
          bptr = bptr - 1                !  index last char of run
        end if                           !  if rpcount
      else                               !  we're not doing repeats
        old = pchar
        rpcount = 1
      end if

100   continue
      savect = rpcount
      !  First look for the special cases :
      if ((native).and.(old.eq.char(FS))) then
        if (pkptr.gt.5) then             !  EOF found - truncate pkt
          result = lastpkt
          go to 400
        else                             !  starting pkt  & hit EOF
          result = nopkt
          go to 900
        end if
      else                               !  these are the std cases
        j = 1                            !  minimum length we need
        !  Does char need a repeat prefix ?
        if ((repeat).and.(rpcount.ge.cutoff)) then
          pktseq(j:j+1) = '~' //kchar(rpcount)
          j = j+2
          rpcount = 1
        end if                         !  if repeat prefixed
        if ((quote8).and.(ichar(old).ge.200b)) then
          pktseq(j:j) = '&'
          old = char(ichar(old).and.177b)
          j = j +1
        else if ((native).and.(old.eq.char(US))) then
          ! we have to convert this to std text EOL sequence
          pktseq(j:j+3) = eolseq
          j = j+3
          go to 120
        end if                           !  if 8th bit prefixing
        !  now encode lo-order 7 bits of the char, if needed
        if ((ichar(old).gt.037b).and.(old.ne.char(177b))
     !   .and.(old.ne.quote)
     !   .and.((old.ne.'&').or.(.not.(quote8)))
     !   .and.((old.ne.'~').or.(.not.(repeat))) )
     !  then                             ! it needs no quoting
          pktseq(j:j) = old
        else
          pktseq(j:j) = quote
          if ((old.ne.quote).and.(old.ne.'&').and.(old.ne.'~'))
     !    then                           !  transform the quoted char
            old = kctl(old)
          end if
          j = j + 1
          pktseq(j:j) = old
        end if
      end if                             !  end of all char cases

120   continue
      do 170 i=1,rpcount
        seqend = pkptr + j - 1
        if (seqend.le.maxpack) then        !  there's room
          packet(px)(pkptr:seqend) = pktseq(1:j)
          pkptr = seqend + 1
        else                             ! coded char wont fit in pkt
          if (savect.ge.cutoff) then    ! it was repeat prefixed
            rpcount = savect - 1
          else if (rpcount.gt.1) then   !  it was a mini-run
            bptr = bptr - (savect-i)     ! index first excluded char
            rpcount = 0                  ! and let it start new scope
          else
            rpcount = 0
          end if
          go to 200
        end if                           !  if room
170   continue

       rpcount = 0
       bptr = bptr + 1
       if(pkptr.le.maxpack) go to 10

200   result = full

400   continue
      packet(px)(2:2) = kchar(pkptr-2)   !  coded count
      packet(px)(3:3) = kchar(mod(seq,64))
      packet(px)(4:4) = 'D'
      packet(px)(pkptr:pkptr) = cksum(packet(px))

900   continue
      return
      end                                !  subroutine makedata


      subroutine putdata(px,result)
      implicit integer(a-z)
      ! Function : This routine is called in the RECEIVE state to
      !            process a 'D' packet.  It packs the data portion
      !            of a 'D' pkt into the character buffer, replacing
      !            quoted and/or prefixed sequences if necessary.
      !            If file is CTSS native, quoted CR,LF sequences are
      !            stored as the single ctss EOL character, Ascii US.
      !            Evaluation of logical function bufout forces transfer
      !            of contents of character buffer into the sector-sized
      !            word buffer dkbuf which is managed by bufout.
      !  Called Procedures : kctl, unchar, bufout

      parameter( CR=015b, LF =012b, US = 037b )
      parameter( buflen = 504 )          !  bufsize = max char string
      parameter( ok=0, error=1 )         !  putdata return codes

      character *504 buffer
      character*104 packet(2)
      character*9 myparms, hisparms, defaults
      character  kctl, quote, qchar, pchar
      logical bufout, eofsw, hibit, debug, native, quote8, repeat
     !        ,lastbuf, savedcr

      common /runparms/ myparms, hisparms, defaults
      common /packets/ packet
      common /buffers/ buffer
      common /pkstats/  bptr, bufleft, maxpack, lastbuf
     !                , rpcount, savedcr
      common /environ/ debug, native, quote8, repeat

      quote = hisparms(6:6)              !  get partner's quote char
      eofsw = .false.
      hibit = .false.
      pkptr = 5                         !  index 1st data char
      pkend = unchar(packet(px)(2:2)) + 1 !  index last data char
10    continue                           !  top of packing loop
      if (pkptr.gt.pkend) then           !  Reached end of packet
        result = ok
        go to 800
      end if
      pchar = packet(px)(pkptr:pkptr)    !  Get next packet character
      !  Check for repeat prefix
      if ((repeat).and.(pchar.eq.'~')) then
        pkptr = pkptr + 1                !  Index count char
        count = unchar(packet(px)(pkptr:pkptr))
        pkptr = pkptr + 1
        pchar = packet(px)(pkptr:pkptr)
      else
        count = 1
      end if                             !  if repeat
      if ((quote8).and.(pchar.eq.'&')) then
        hibit = .true.
        pkptr = pkptr + 1                !  Index prefixed character
        pchar = packet(px)(pkptr:pkptr)
      else
        hibit = .false.
      end if                             !  If 8th bit quoting
      if (pchar.eq.quote)  then      !  Character is quoted ctl
        pkptr = pkptr + 1            !  Index the quoted character
        pchar = packet(px)(pkptr:pkptr)
        if ((pchar.ne.quote).and.(pchar.ne.'&').and.(pchar.ne.'~'))
     !  then
          pchar = kctl(pchar)            !  Transform quoted character
        end if
      end if                             !  If quoted sequence
      if (hibit) then                    !  Char had an 8th bit prefix
        pchar = char(ichar(pchar).or.200b)
      else if ((native).and.(count.eq.1)) then
        ! Map incoming CR,LF sequences to CTSS end-of-line char
        if ((pchar.eq.char(LF)).and.(savedcr)) then
          pchar = char(US)               !  Replace by native EOL char
          savedcr = .false.
        else if (savedcr) then           !  Previous CR not in a sequence
          pchar = char(CR)
          savedcr = .false.
          pkptr = pkptr - 1              !  Pick up current char nxt time
        else if (pchar.eq.char(CR)) then
          savedcr = .true.
        end if
      end if
      if (.not.(savedcr))  then          !  Put char into buffer
        do 40 i=1,count
          if (bptr.gt.buflen)  then      !  Need to empty buffer first
            if (.not.(bufout(buffer,eofsw))) then
              result = error
              go to 800
            end if
          end if
          buffer(bptr:bptr) = pchar      !  Put pkt char into buffer
          bptr = bptr + 1
40      continue
      end if
      pkptr = pkptr + 1
      go to 10                           !  Bottom of unpacking loop

800   continue
      return
      end                          !  subroutine putdata


      logical function puteof(usrfil)
      implicit integer(a-z)
      ! Function : This routine is called in the RECEIVE state to
      !            process a 'Z' packet.  It terminates CTSS native but not
      !            other, files with an Ascii FS character,  and
      !            evaluates the logical function bufout with 2nd arg
      !            set .true. to force a write of the last sector now.
      !            If user's filespace has an old copy of the receive file,
      !            this copy is destroyed before switching receive file's
      !            name from the interim 'kmtfil' to name in 'F' pkt.
      !  Called Procedures : bufout, logline, kfdelete, kfswitch

      parameter( buflen = 504 )          !  max length character string

      character dum1*4                   ! debuggery
      logical debug, native
      character kchar
      character *504 buffer
      character cmdstr*80
      logical oldfile, bufout, kfdelete, kfswitch
      parameter( NULL = 0, FS = 034b, US = 037b )

      common /buffers/ buffer
      common /pkstats/  bptr, bufleft
      common /strings/ cmdstr
      common /environ/ debug, native

      dimension beta(4)

      if (native) then             !  File needs CTSS EOF terminator
        if (bptr.gt.buflen) then   !  Buffer already full
          if(.not.(bufout(buffer,.false.))) go to 300
        end if                     !  else evaluation emptied buffer
        buffer(bptr:bptr) = char(FS)
        bptr = bptr + 1
      end if
      nx = mod(bptr-1,8)           !  Index last byte used in final word
      if (nx.ne.0)  then           !  Pad out last word with nulls
        wdend = bptr + 7 - nx
        do 200 i=bptr,wdend
          buffer(i:i) = char(NULL)
200     continue
        bptr = wdend + 1
      end if
      if (bufout(buffer,.true.)) then    !  final write succeeeds
        !  see if we are replacing an existing copy
        inquire(iostat=ios,file=cmdstr(1:8),exist=oldfile)
        if (ios.eq.0)  then
          if (oldfile) then
            call logline('old file copy exists$$')
            if (.not.(kfdelete(usrfil))) go to 300
          end if                         !  if oldfile
          if (kfswitch(usrfil))  then    !  if std file renemed ok
            puteof = .true.
            go to 400
          end if                         !  if kfswitch
        end if                           !  if ios
      end if                             !  if bufout
300   puteof = .false.
400   continue
      return
      end                                !  logical fn puteof


      logical function bufin(string,last)
      implicit integer(a-z)
      ! Function : This is a virtual disk read routine.
      !            It packs 63 words from the sector-sized buffer dkbuf
      !            into the buffer used as caller's first argument.
      !            BUFIN resets the string pointers bptr and bufhold.
      !            When dkbuf is empty, BUFIN evaluates the logical
      !            function KFREAD to force a physical disk sector read.
      !            Upon return from BUFIN, the parameter LAST is true
      !            iff current string is the last of the file.
      ! Called Procedures : kfread.
      !            .
      parameter( fs = 034b )
      dimension string(63)               !  treat 504 char buf as 63 words
      dimension dkbuf(512)               !  sector-sized buffer
      logical dkempty, kfread, last

      common /units/ logioc, fioc, dkctr, dkbuf, nsectors
     !              ,fptr, dkptr, dkhold
      common /pkstats/  bptr, bufhold

      place = 1                          !  Index 1st word of string
10    continue
      dkempty = .false.
      do 20 i=place,63
        if (dkptr.gt.dkhold)  then
          dkempty = .true.
          go to 40
        else
          string(i) = dkbuf(dkptr)       !  put a word into string
          dkptr = dkptr + 1              !  Index next sector word
        end if
20    continue
40    if (.not.(dkempty))  then          !  String is full
        sx = 63
      else if (dkctr.eq.nsectors) then   !  Exhausted last sector
        sx = i - 1                       !  Index last string word used
      else if (.not.(kfread())) then     !  Forced sector read failed
        bufin = .false.
        go to 800
      else                               !  Sector buffer replenished
        place = i                        !  Index next string word
        go to 10                         !  Go continuing filling string
      end if
      bptr = 1                           !  Point to start of string
      bufhold = sx*8                     ! Num. bytes in string
      !  Is this the last string of the file ?
      if ((sx.eq.63).and.((dkctr.lt.nsectors).or.(dkptr.le.dkhold)))
     !then
        last = .false.
      else
        last = .true.
      end if
      bufin = .true.
800   continue
      return
      end                                !  logical function bufin

      logical function bufout(string,eof)
      implicit integer(a-z)
      ! Function : This is a virtual disk write routine that packs the
      !            contents of the caller's buffer into the 512-word sector
      !            buffer dkbuf.  Caller's buffer is assumed to be at most
      !            504 characters long (the maximum CFT string), with bptr
      !            indexing  past the last position used, and is treated as
      !            an array of 63 words.  When dkbuf is full, or if entered
      !            with eof argument .true., kfwrite is called to do the
      !            physical disk write.
      ! Called Procedures : kfwrite, kfprune, logline, tdisp
      logical eof, dkfull, kfwrite
      parameter( buflen = 504 )          !  max num. chars in string
      parameter( sector = 512 )
      logical debug

      common /pkstats/  bptr, bufhold
      common /units/ logioc, fioc, dkctr, dkbuf(sector), nsectors,
     !             fptr, dkptr, dkhold
      common /environ/ debug

      character*4 dum1
      dimension string(63)               !  treat 504 chars as 63 words

      nchar = bptr - 1                   !  num. chars in string
      nwords = nchar/8                   !  num. words in string
      dkfull = .false.
      do 20 i=1,nwords
        if(dkptr.gt.sector)  then
          dkfull = .true.
          go to 30
        else
          dkbuf(dkptr) = string(i)
          dkptr = dkptr + 1
        end if
20    continue
      !  see if string fit into dkbuf
30    if (dkfull)  then                  !  it didn't
        if (kfwrite(sector))  then  !  wrote dkbuf to disk
          do 50 j=i,nwords               !  put string remnant in new buf
            dkbuf(dkptr) = string(j)
            dkptr = dkptr + 1
50        continue
        else                             !  if write failed
          bufout = .false.
          go to 400
        end if                           !  if kfwrite
      end if                             !  if dkfull
      bufout = .true.                       !  Default evaluation
      if (.not.(eof))  then
        bptr = 1                            !  indicate string empty
        bufhold = buflen
      else                                  !  Write final partial sector
        nsiz = dkptr - 1                !  num. words in last sector.
        if(kfwrite(nsiz)) then
          fwords = (dkctr-1)*sector + nsiz     !  real file size in words
          call kfprune(fwords)              !  make file size exact
          if (debug) then
            call tdisp(fwords,dum1)
            call logline('At EOF - file size is : '//dum1//' words$$')
          end if
        else
         bufout = .false.
        end if                           !  if kfwrite
      end if                             !  if eof
400   continue
      return
      end                                !  logical fn bufout
!-cr.kermain-!
      !  Kermit-CR  -  LANL Cray Kermit
      !
      !  Author :  Leah Miller,
      !            Computer User Services Group (C-10)
      !            Los Alamos National Laboratory
      !            Los Alamos, New Mexico  87545
      !
      !            Arpanet address :  lfm@lanl
      !

      !*******************************************************************
      !  Copyright, 1984, The Regents of the University of California.
      !  This software was produced under a U.S. Government contract
      !  (W-7405-ENG-36)  by the Los Alamos National Laboratory, which is
      !  operated by the University of California for the U.S. Department
      !  of Energy.  The U.S. Government is licensed to use, reproduce and
      !  distribute this software.  Permission is granted to the public to
      !  copy and use this software without charge, provided that this notice
      !  and any statement of authorship are reproduced on all copies.
      !  Neither the Government nor the University makes any warranty,
      !  express or implied, or assumes any liability or responsibility
      !  for the use of this software.
      !*******************************************************************

      !  Acknowledgement :  The Kermit Protocol was developed by the
      !                     Columbia University Center for Computing
      !                     Activities (CUCCA),  N.Y., N.Y., USA

      !    Kermit-CR runs on the Cray-1 and Cray X-MP computers, under
      !  the CTSS (Cray Time-Sharing System) Operating System.
      !  It is written in CFT, the Cray version of Fortran-77.
      !  All input/output functions are done by invoking CTSS operating
      !  system functions from low level Fortran subroutines.
      !
      !    Kermit-CR is a remote host Kermit.  It has a server
      !  and can time out.  File transfer interrupt  packets from
      !  local Kermits are recognized.  Default file transfer
      !  mode is CTSS native text.  In this mode the single character
      !  CTSS end-of-line indicator (Ascii US) is converted to
      !  the standard quoted CR,LF sequence on sends, and vice-versa
      !  on receives.  If this option is disabled by user's command
      !  "set native off", only the standard Kermit quoting of control
      !  characters is done.  Binary files may be transferred via 8th bit
      !  quoting if the local Kermit also has this capability.
      !  Data compression via repeat prefixing will be done if the other
      !  Kermit agrees.
      !  Wildcard sends are not done, but more than one file may be
      !  specified on a send command (non-server mode).
      !  The Kermit-CR server cannot log itself it, so that a local
      !  Kermit's "finish" or "bye" command will cause exit from
      !  Kermit-CR and return to the CTSS level.
      !
      !    Installers should note that Cray-1 and Cray X-MP, under CTSS,
      !  accept line, not character, input.  Network line concentrator
      !  hardware may impose a maximum message length of less than
      !  the maximum Kermit packet length.  This hardware may also perform
      !  echoback of terminal messages.  If the local Kermit does not
      !  check incoming packet type (and ignore packets of type just sent),
      !  then the local Kermit may use appropriate PAD and EOL characters
      !  to disable concentrator echoback.
      !  Site Dependancy : Some network line concentrators are unable to
      !                    keep up with the data rate of a SENDing local
      !                    Kermit unless echoback is disabled.  [lfm 1/85]

      program kermit(input=tty,output=tty)
      implicit integer(a-z)

      !  Function :  This is the main Kermit-CR program.
      !              Session initialization is forced via evaluation
      !              of the logical function KINIT, and the programs enters
      !              a command loop:  user's input command is accepted
      !              by subroutine READCMD, validated & parsed into tokens
      !              by KPARSE, and the appropriate command interpreter is
      !              invoked.  Exit from loop occurs when user types the
      !              exit command, or when the Kermit-CR Server enters exit
      !              mode in response to local Kermit's 'finish', 'bye'  or
      !              'logout' packet.
      !  Called Procedures :  kinit, prompt, logline, readcmd, kparse,
      !                       display.  Also these cmd interpreters :
      !                         kserv, ktrans, krecv, kset, kstatus,
      !                         khelp and kclose.

      character *80 cmdstr
      character *40 report

      logical kparse, kinit
      logical debug, done

      common /strings/ cmdstr, report
      common /states/ state, retry, ntries, oldtries, seq
     !              , delay, stdelay,tcpu, tio
      common /globals/ runtype, nargs, args(10,2), thisarg

      parameter(send=1, receive = 2, help = 3, exitype = 4, server = 5 )
      parameter(set = 6, status = 7 )
      parameter( init = 1, abort = 6, complete = 7 )
      parameter( wait = 0 )

      ! main proc. rtne.
      print *,'  LANL Cray Kermit Release 2.1'
      !  Evaluate initialization function :
      if (.not.(kinit()))  then
        print *,' cant initialize - bye.'
        go to 900       ! can't initialize
      end if                             !  else session initialized
      done = .false.
120   continue                           !  Top of command loop
      call prompt('Kermit-CR>.')         ! prompt user
      call readcmd(strad(cmdstr),cmdlen) ! get user's cmd & its length
      if (cmdlen.gt.0) then
        call logline(cmdstr(1:cmdlen)//'$$')
      else                               !  it's a bare CR
        go to 120                        !  Ignore it - reissue prompt
      end if                             ! if user typed a command
      if (kparse()) then
        go to 200                        ! valid cmd
      else                               !  kparse provides report
        call logline(report)
        call display(report)
        call display( 'type help for menu.')
        go to 120
      end if
200   continue     ! kparse has parsed a valid cmd
      if (runtype .eq. server) then
          call kserv                     !  start Server loop
          call kclose                    !  shut log file
          done = .true.                  !  tell Kermit to exit
      else if ( runtype .eq. send ) then
          call ktrans
      else if (runtype .eq. receive) then
          state = init                   !  initialize non-server xfer
          call krecv
      else if (runtype .eq. help) then
          call khelp
      else if (runtype .eq. exitype) then
          call kclose
          done = .true.
      else if (runtype .eq. set) then
        call kset
      else if (runtype .eq. status) then
        call kstatus
      else
          call logline('cmd parse error.$$')
      end if

      if (.not.(done)) go to 120         !  Bottom of command loop
900   continue
      call exit
      end     ! kermit main program


      logical function kparse()
      ! scans user's input line in cmdstr for valid cmd type;
      ! if cmd = (server, status, receive, help, exit) :
      !                            sets runtype, returns .true.
      ! if cmd = (send, set)     : sets runtype, sets nargs <= num.args.,
      !                            args(i,1) <= index of start ith argument
      !                                        in input command string,
      !                            args(i,2) <= index  last char of ith arg.
      ! else  rturns .false.
      ! Called Procedures : none

      implicit integer(a-z)
      character *80 cmdstr
      character *40 report
      common /strings/ cmdstr, report
      common /globals/ runtype, nargs, args(10,2), thisarg

      parameter( send=1, receive=2, help=3, exitype=4, server = 5 )
      parameter( set = 6, status = 7 )
      parameter( cr = 13 )

      nargs = 0
      ! look for cmd type
      if ( cmdstr (1:6) .eq. 'server' ) then
        runtype = server
        go to 800
      else if (cmdstr(1:3).eq.'set') then
        runtype = set
      else if (cmdstr(1:2).eq.'st') then
        runtype = status
        go to 800
      else if (cmdstr (1:1) .eq. 's' ) then
        runtype = send
      else if ( cmdstr (1:1) .eq. 'r' ) then
        runtype = receive
        go to 800
      else if ( (cmdstr (1:1) .eq. 'h').or.(cmdstr(1:1).eq.'?')) then
        runtype = help
        go to 800   ! no args to scan
      else if ( cmdstr (1:1) .eq. 'e' ) then
        runtype = exitype
        go to 800
      else
        report = 'invalid cmd type:' // cmdstr(1:1) //'.'
        kparse = .false.
        go to 900
      end if
      ! find end of cmd arg
      i = 1
20    continue
      i = i + 1
      if (cmdstr (i:i) .eq. ' ') go to 30
      if ( i .ge. 8 ) go to 700    ! error : arg too long
      go to 20
      ! find start of next arg : skip past blanks
30    continue
      if ( i .ge. 80 ) go to 780   ! there are no more args
      i = i + 1
      if ( cmdstr (i:i) .eq. ' ') go to 30   ! loop til nonblank
      ! else current char marks start of nxt argument
      nargs = nargs + 1
      if (nargs .gt. 10) go to 600    ! error : too many args
      args(nargs,1) = i     ! save starting position
      ! find end of current aerg
40    continue
      i = i + 1
      if ((cmdstr(i:i) .eq. ' ') .or. (cmdstr(i:i) .eq. char(cr)))
     !    go to 50
      if ( (i-args(nargs,1)) .ge. 8 ) go to 700  ! too long
      go to 40             ! loop til term delimiter found
50    continue
      args(nargs,2) = i - 1
      if (cmdstr (i:i) .eq. ' ') go to 30    ! if blank was delimiter
      go to 880                              ! if  delimiter
600   continue
      report = 'more than 10 args.'
      kparse = .false.
      go to 900
700   continue
      report = 'arg length exceeds 8:' // cmdstr(args(nargs,1):i)//'.'
      kparse = .false.
      go to 900
780   continue
      if (nargs .eq. 0) then
        report = 'no arguments.'
        kparse = .false.
        go to 900
      end if

800   continue
880   continue
      kparse = .true.
900   return
      end       ! logical function kparse


      logical function kinit()
      implicit integer(a-z)
      !  Function : This is the session initialization function.  It sets
      !             session parameters to their default values and creates
      !             a new session logfile, destroying the previous
      !             logfile if one exits.
      !  Called Procedures :  kchar, kctl, initlog.
      logical logging, debug, native, quote8, repeat, echo
      parameter( CR = 13, CTLW = 23, CTLZ = 26,  null = 0 )
      parameter( soh = 01 )
      parameter( ns = 15 )
      parameter( LINEBUF = 86 )          ! current length of kbd input buf
      parameter( SITEMAX = LINEBUF-4)
      character pad, eol, quote, bq8, cktype, repchar
      character bufsize,timout, npad
      character rpkthead
      character *9 myparms, hisparms, dflt
      character kchar, kctl

      common /units/ logioc, fioc, dkctr, dkbuf(512), nsectors,
     !            fptr, dkptr, dkhold
      common /states/ state, retry, ntries, oldtries, seq, delay
     !      , stdelay
      common /runparms/ myparms, hisparms, dflt
      common /environ/ debug, native, quote8, repeat, window, echo

      equivalence (bufsize,dflt(1:1)),(timout,dflt(2:2)),
     ! (npad,dflt(3:3)),(pad,dflt(4:4)),(eol,dflt(5:5)),
     ! (quote,dflt(6:6)),
     ! (bq8,dflt(7:7)),(cktype,dflt(8:8)),(repchar,dflt(9:9))

      ! set default system parameters
      bufsize  = kchar(SITEMAX)    ! His safe max COUNT for pkts
      timout = kchar(ns)    ! I want ns secs. to respond, by his clock
      npad = kchar(0)
      pad = kctl(null)
      eol = kchar(CR)     ! end pkts to me with this kchar
      quote = '#'
      bq8 = 'N'             ! Default filetype is Ascii text
      cktype = '1'          ! Default is single character checksums
      repchar = ' '         ! Default is no data compression


      myparms(1:9) = dflt(1:9)   ! Initialize to defaults


      !  Site-dependancy : current line concentrator hardware echoes back
      !                    packets. The following NPAD, PAD and EOL chars
      !                    are used to disable echoback.  If echoback isn't
      !                    disabled, then transmissions will fail (even if
      !                    local Kermit detects and ignores echo) because
      !                    local Kermit's packets swamp the concentrator.
      myparms(3:5) = kchar(1)//kctl(char(CTLZ))//kchar(CTLW)

      myparms(7:7) = '&'                 !  My 8th bit prefix char
      myparms(9:9) = '~'                 !  My repeat count prefix

      !  Use this default till we get his params :
      hisparms(5:5) = char(CR)           ! store the real character

      logioc = 8
      fioc = 9

      delay = 5000000        ! default Cray timeout = 5 secs.
      stdelay = delay
      retry = 5              ! I'll retry up to 5 times

      ! Establish default session environment :
      debug = .false.
      native = .true.        !  Default filetype is ctss native text
      echo = .true.          !  Assume  echoback must be disabled
      window = 1             !  Default size of floating window

      seq = 0

      ! initialize session log
      call initlog(logging)
      kinit = logging
900   continue

        return
      end                   !  logical function kinit

      subroutine kclose()
      implicit integer(a-z)
      !  Function : This is the EXIT command interpreter,  but is also
      !             invoked upon return to main program from server mode.
      !             It merely closes the session logfile.  All data files
      !             are closed by the appropriate state-switcher when
      !             the current command (SEND/RECEIVE) completes or aborts.


      call endlog()
      return
      end

!-cr.kfutil-!
      !  This module contains a collection of bottom-level Fortran
      !  subroutines, each of which invokes a CTSS operating system
      !  function via a call to the library routine SYCALL.
      !  The first SYCALL parameter is a literal index of the CTSS
      !  function requested.  The second SYCALL parameter names the
      !  array by which request parameters are passed between the
      !  caller and CTSS.  Result codes are returned in the second word
      !  of this array.  Their meaning may be site-dependent.  The
      !  possibility of error recovery is site-dependent.

      subroutine readcmd(buffer,cmdlen)
      implicit integer(a-z)
      ! Function : reads user's command from keyboard controller
      !            into buffer used as 1st argument,
      !            returns command length in 2nd argument.
      ! Called Procedures : sycall

      parameter (cmdmax=80)
      parameter( wait = 0 )
      dimension alpha(5)

      alpha(3) = buffer                  !  Address of caller's buffer
      alpha(4) = cmdmax
      alpha(5) = wait                    !  Wait until something is typed
      call sycall(4l1500,alpha)          !  Read msg from kbd controller
      cmdlen = alpha(4)                  !  Number of chars read

      return
      end                                ! subroutine readcmd

      logical function kfspace(listadr, listmax, numfiles)
      implicit integer(a-z)
      ! Function : gets list of private files in user's filespace
      !            into buffer addressed by first argument;
      !            if no error and  0 < number_of_files <= 256, then
      !            evaluates TRUE with number of files in second argument,
      !            else evaluates false with numfiles := 0.
      ! Called Procedures : sycall, logline
      dimension beta(5)

      beta(3) = listadr
      beta(4) = 2*listmax        ! num. words is 2*(max no. entries)
      beta(5) = 0
      call sycall(4l1001,beta)   ! Get private file list
      if (beta(2).eq.0) then
        numfiles = beta(4)/2
        kfspace = .true.
      else
        numfiles = 0
        kfspace = .false.
      end if
      return
      end                        ! logical function kfspace

      logical function kfopen(fname)
      implicit integer(a-z)
      ! Function : opens file fname on kermit std. ioc, returns .true.,
      !            else  returns .false.
      ! Called Procedures : sycall, tdisp, logline
      parameter( readacc = 2 )

      dimension dkbuf(512)
      logical debug

      common /units/ logioc, fioc, dkctr, dkbuf,nsectors
     !              , fptr, dkptr, dkhold
      common /environ/ debug

      dimension beta(12)
      character*4 code, dum1, dum2

      beta(3) = fname
      beta(4) = fioc
      beta(7) = readacc
      call sycall(4l0300,beta)
      if (beta(2) .eq. 0) then
        kfopen = .true.
        nx = beta(5)/512                 ! get num. full sectors in file
        if (nx*512.eq.beta(5))  then     ! no remainder
          nsectors = nx
        else
          nsectors = nx + 1
        end if
        fptr = 0                         !  initialize file offset (words)
        dkptr = 1
        dkhold = 0                       !  declare sector buffer empty
        dkctr = 0                        !  initialize sectors-read counter
        if (debug) then                  !  log system info
          call tdisp(nsectors,dum1)
          call tdisp(beta(5),dum2)
          call logline('opened file has  '//dum1//' sectors,'//
     !    dum2 // ' words$$')
        end if                           ! if debug
      else
        kfopen = .false.
        if (debug) then                  ! log the cause of failure
          call tdisp(beta(2),code)       !  make error code printable
          call logline('open fails with code:'//code//'$$')
        end if                           ! if debug
      end if
      return
      end      ! subroutine kfopen

      subroutine kfclose()
      implicit integer(a-z)
      ! Function : close  kermit std ioc
      ! Called Procedures : sycall
      parameter( sameacc = 0, samesec = 0, samelen = 0 )

      common /units/ logioc, fioc

      dimension beta(6)

      beta(3) = samesec
      beta(4) = fioc
      beta(5) = sameacc
      beta(6) = samelen
      call sycall(4l0400,beta)
      return
      end

      logical function kfcreate()
      implicit integer(a-z)
      ! Function : Destroys old kmt std recv file, if it exists,
      !                and creates a new one.
      common /units/ logioc, fioc, dkctr, dkbuf, nsectors, fptr, dkptr
      parameter(sector=512)
      dimension beta(9)
      dimension dkbuf(sector)

      beta(3) = 'kmtfil'                 !  std recv file name
      beta(4) = fioc
      beta(5) = sector                      !  ask for 1 sector initially
      beta(6) = 0
      beta(7) = 3
      call sycall(4l0101,beta)           !  create std file & destroy old
      if (beta(2).eq.0) then
        dkctr = 0                        ! initialize sector write ctr
        dkptr = 1                        !  initialize sector buffer ptr
        fptr = 0                         !  initialize file offset (words)
        kfcreate = .true.
      else
        kfcreate = .false.               !  if error
      end if
      return
      end                                !  logical fn kfcreate

      logical function kfdelete(usrfil)
      implicit integer(a-z)
      dimension beta(4)

      beta(3) = usrfil                   !  name of file to delete
      call sycall(4l0200,beta)           !  delete it
      if (beta(2).eq.0)  then
        kfdelete = .true.                !  file was deleted
      else
        kfdelete = .false.
      end if
      return
      end                                !  logical fn kfdelete

      logical function kfswitch(usrfil)
      implicit integer(a-z)
      dimension beta(4)

      call kfclose                       !  close kmt std i/o file
      beta(3) = 'kmtfil'                 !  old name = std file name
      beta(4) = usrfil                   !  new name = caller's arg.
      call sycall(4l0600,beta)           !  rename std file to arg name
      if (beta(2).eq.0) then
        kfswitch = .true.                !  file was renamed ok
      else
        kfswitch = .false.
      end if
      return
      end                                !  logical fn kfswitch

      logical function kfwrite(n)
      implicit integer(a-z)
      dimension dkbuf(512)
      common /units/ logioc, fioc, dkctr, dkbuf, nsectors, fptr
     !              , dkptr
      dimension alpha(3), beta(9)

      beta(3) = fioc
      beta(6) = loc(dkbuf)               !  Word addr of Sector buffer
      beta(7) = fptr
      beta(8) = n                        !  number of words to write
      beta(9) = 0
      call sycall(4l6000,beta)           !  start disk write
      alpha(3) = fioc
      call sycall(4l4001,alpha)          !  wait for dk write to complete
      if (beta(2).eq.0)  then            !  dk write was successful
        fptr = fptr + beta(4)
        dkptr = 1                        !  sector buffer now empty
        kfwrite = .true.
        dkctr = dkctr + 1                !  incr disk write count
        if(n.eq.512) then                !  wrote full sector, need another
          beta(3) = 'kmtfil'
          beta(4) = (dkctr+1)*512        !  new file size wanted in wds
          call sycall(4l0702,beta)       !  request another sector
          if (beta(2).ne.0)  kfwrite = .false.
        end if                           !  if we filled our sector
      else
        kfwrite = .false.
      end if
      return
      end                                !  logical fn kfwrite

      logical function kfread()
      implicit integer(a-z)
      !  Function :  attempts to read 1 sector from Kermit std file ioc
      !              into common buffer dkbuf.
      !  Called Procedures :  sycall, logline

      dimension dkbuf(512)               !  sector-sized buffer
      logical debug
      common /units/ logioc, fioc, dkctr, dkbuf, nsectors, fptr,
     !             dkptr, dkhold
      common /environ/ debug

      dimension alpha(3), beta(9)
      character wval*4                   !  debuggery

      beta(3) = fioc                     !  device is std Kermit ioc
      beta(6) = loc(dkbuf)               !  addr of sector buf in common
      beta(7) = fptr                     !  current file offset in words
      beta(8) = 512                      !  request a whole sector
      beta(9) = 0                        ! no interrupt rtne - we'll wait
      call sycall(4l5000,beta)           !  start disk read
      alpha(3) = fioc
      call sycall(4l4001,alpha)          !  wait for read completion
      if((beta(2).eq.0).or.(beta(2).eq.020b)) then
        if (debug) then
          call tdisp(beta(4),wval)         !  debuggery
          call logline('# wds read is '//wval//'$$') ! debuggery
        end if
        dkhold = beta(4)                 !  num. words read
        fptr = fptr + beta(4)
        dkctr = dkctr + 1                !  incr count of no. sectors read
        dkptr = 1
        kfread = .true.
      else                               !  trouble with read
        kfread = .false.
      end if
      return
      end                                !  logical function kfread

      subroutine kfprune(fsize)
      implicit integer(a-z)
      ! Function : returns unused part of disk allocation
      !            for std Kermit io file.
      ! Called Procedures : sycall
      dimension beta(4)

      beta(3) = 'kmtfil'
      beta(4) = fsize
      call sycall(4l0702,beta)           !  make file size exact
      return
      end                                !  subroutine kfprune

      subroutine kgetime(tcpu,tio)
      implicit integer(a-z)
      dimension beta(8)

      do 10 i=2,8
10      beta(i) = 0
      call sycall(4l1031,beta)           ! get real cpu,io times used.
      tcpu = beta(3)
      tio = beta(4)
      return
      end                                !  subroutine kgetime

      subroutine displays
      implicit integer(a-z)

      character *40 string
      parameter( cr=13, lf=10 )
      logical nl

      character cmdstr*80, report*40
      common /strings/ cmdstr, report
      dimension beta(5)

      entry display(string)

      nl = .true.
      go to 10

      entry prompt(string)

      nl = .false.

10    continue
      strep = strad(report)
      if (strad(string) .ne. strep) then
        report = string       ! if argument is a literal
      end if
      beta(3) = strep
      k = index(report,'.')
      if (k.eq.0) k =39
      if (nl) then
        report(k:k+1) = char(13) // char(10)    ! cr lf
        beta(4) = k + 1
      else
        beta(4) = k-1
      end if
      beta(5) = 1
      call sycall(4l1400,beta)   ! send msg to tty ctlr
      return
      end

!-cr.kutcmds-!
      subroutine kserv()
      implicit integer(a-z)
      ! Function : This is the Kermit Server cmd interpreter.
      !            It is a command packet accepting loop, with exit
      !            to top-level upon receiving a FINISH("GF") or
      !            BYE/LOGOUT('GL") pkt from other Kermit.
      !            Note : Cray Kermit does not log itself out.
      ! Called Procedures :  getpkt, unchar, stdname, ktrans, krecv,
      !                      sendack, decode, encode, sendpkt,
      !                      errorpkt, logline.

      logical done, ok
      character ptype
      character *104 packet(2)
      character cmdstr*80, report*40
      common /globals/ runtype, nargs, args(10,2), thisarg
      common /states/ state, retry, ntries, oldtries, seq
     !               , delay, stdelay
      common /packets/ packet
      common /strings/ cmdstr, report

      parameter( init = 1, hdr = 2, abort = 6 )  ! states
      parameter(good = 0, bad = 1, timeout = 2, escape = 3)
      parameter( exitype = 4 )           !  runtype on exit

      done = .false.
10    continue                           !  top of Server loop
      call getpkt(1,status)              !  look for cmd pkt
      if (status.eq.good)  then          !  got a good pkt
        ptype = packet(1)(4:4)
        if (ptype.eq.'R')  then          !  they want to receive
          !  get filename from R pkt
          last = unchar(packet(1)(2:2)) + 1
          if (last.gt.4)  then
            nargs = 1
            lx = last - 4
            cmdstr(1:8) = packet(1)(5:last)
            call stdname(cmdstr(1:8))    !  convert name to lower case
            args(1,1) = 1
            args(1,2) = lx
            thisarg = 1
            call ktrans        !  call send state switcher
          else
            report = 'Server - no filename.'
            done = .true.
          end if                         !  if good file name
        else if (ptype.eq.'S') then      !  they want to send
            call krecv               !  call receive state switcher
        else if (ptype.eq.'G')  then     !  Generic Server pkt type
          ptype = packet(1)(5:5)         !  1st Data char tells cmd
          if ((ptype.ne.'F').and.(ptype.ne.'L')) then
            report = 'Server - unknown G code:'//ptype//'.'
          else                           ! It's a valid G pkt code
            call sendack(2,' ','Y')      !  ACK it
            report = 'Server - shut down by Partner.'
          end if                         !  if cmdtype in G pkt
          done = .true.
        else if (ptype.eq.'I') then
          call decode(1,ok)               ! Decode their new initial params
          if (ok) then                    ! we can comply
            call encode(2,0,'Y')          ! make a 'Y' pkt with our params
            call sendpkt(2)               ! reply with our params
          else
            report = 'cant comply with params.'
            done = .true.
          end if
        else
          report = 'Server - unknown pkt type:'//ptype//'.'
          done = .true.
        end if                              !  if good status
      else if (status.ne.escape) then    !  if bad pkt or timeout
        call sendack(2,' ','N')          !  NAK it
      else
        report = 'Server - aborted.'
        done = .true.
      end if                             !  if getpkt
      if (.not.(done))  then
        go to 10                         !  go get another server pkt
      else                               !  this is exit from server loop
        call errorpkt(report)
        call logline(report)
        runtype = exitype                !  tell Kermit to shut down
      end if

      return
      end


      subroutine kstatus()
      implicit integer(a-z)
      ! Function : This is the STATUS command interpreter.  It displays
      !            current Cray settable parameters.
      ! Called Procedures :  tdisp, unchar

      character report*40, value*4, kctl
      character*9 myparms, hisparms, defaults
       logical debug, native, quote8, repeat, echo

      common /states/ state, retry, ntries, oldtries, seq
     !      , delay, stdelay
      common /runparms/ myparms, hisparms, defaults
      common /environ/ debug, native, quote8, repeat, window, echo

      call tdisp(stdelay/1000000,value)  !  convert stdelay to ascii secs.
      report = 'timeout delay is ' //value //'.'
      print *,report
      call tdisp(retry,value)
      report = 'max num tries is ' //value(3:4) // '.'
      print *,report
      if (debug) then
        value = 'on'
      else
        value = 'off'
      end if
      report = 'debug '//value//'.'
      print *,report
      call tdisp(unchar(myparms(1:1)),value)  ! convert coded char
      report = 'Cray receiving bufsize is '//value(3:4)//' chars.'
      print *,report
      if (native) then
        value = 'on'
      else
        value = 'off'
      end if
      report = 'ctss native text mode '//value//'.'
      print *,report

      ! Site dependancy: see comments in KSET interpreter.
      !                  This param is not yet made SETable.
      !if (echo) then
      !  value = 'on'
      !else
      !  value = 'off'
      !end if
      !report = 'echoback disable '//value//'.'
      !print *, report

      !  Floating Window option not yet implemented
      !    call tdisp(window,value)
      !    report = 'window width is '//value//'.'
      !    print *, report

      return
      end                      ! subroutine kstatus

      subroutine kset()
      implicit integer(a-z)
      ! Function : This is is the SET command interpreter.  It changes
      !            the  Cray delay time, retry, debug, bufsize or
      !            filetype parameters for current session.
      ! Called Procedures :  kchar, kctl, unchar, sethelp

      parameter( MINPKT = 20, MAXPKT = 94 )
      parameter( CTLZ = 26, CTLW = 23)
      parameter( microsec = 1000000 )
      character *80 cmdstr
      character *40 report
      character type*3, opt*2, numstr*2, lim1*4, lim2*4
      character*9 myparms, hisparms, defaults
      logical debug, turnon, native, quote8, repeat, echo
      logical code
      character kchar, kctl

      common /strings/ cmdstr, report
      common /states/ state, retry, ntries, oldtries, seq
     !               , delay, stdelay
      common /globals/ runtype, nargs, args(10,2)
      common /runparms/ myparms, hisparms, defaults
      common /environ/ debug, native, quote8, repeat, window, echo

      if (nargs.eq.1) then
        if ( (cmdstr(args(1,1):args(1,1)).eq.'?')
     !  .or. (cmdstr(args(1,1):args(1,1)+3).eq.'help')) then
          call sethelp()
          return
        end if                           !  If user requested help
      end if
      if (nargs.lt.2) then
        print *, ' set <option> <value>.'
      else
        type = cmdstr(args(1,1):args(1,1)+2)
        if ((type.eq.'deb').or.(type.eq.'nat').or.(type.eq.'ech'))
     !  then                            !  These are the ON | OFF options
          opt = cmdstr(args(2,1):args(2,1)+1)
          if ((opt.eq.'on').or.(opt.eq.'ON')) then
            turnon = .true.
          else if ((opt.eq.'of').or.(opt.eq.'OF')) then
            turnon = .false.
          else
            print *, '     option values:  on | off.'
            go to 800
          end if                    !  if option value
          if (type.eq.'deb') then
            debug = turnon
          ! Site dependancy: defer implementation of the SET ECHO <ON|OFF>
          !                  cmd because current KCC's (network line
          !                  concentrators) cannot keep up with a SENDing
          !                  local Kermit's data rate, if echoback is
          !                  enabled.
          !else if (type.eq.'ech') then
             !echo = turnon
             !if (echo) then
             !  myparms(3:5) = kchar(1)//kctl(char(CTLZ))//kchar(CTLW)
             !  myparms(1:1) = kchar(unchar(defaults(1:1))-2)
             !else
             !  myparms(3:5) = defaults(3:5)
             !  myparms(1:1) = defaults(1:1)
             !end if
          else
            native = turnon
          end if
        else if ((type.eq.'tim').or.(type.eq.'ret').or.(type.eq.'buf'))
     !  then
          vlen = args(2,2) - args(2,1) + 1
          if (vlen.gt.2) then
            print *, ': value is 1 or 2 decimal digits.'
            go to 800
          else if (vlen.eq.1) then
            numstr = '0'//cmdstr(args(2,1):args(2,1))
          else
            numstr = cmdstr(args(2,1):args(2,2))
          end if
          call undisp(numstr,value,code)
          if (.not.(code)) then
            print *, ': use decimal characters for value.'
            go to 800
          end if
          if (type.eq.'tim') then
            stdelay = value * microsec
          else if (type.eq.'ret') then
            retry = value
          else if (type.eq.'buf') then
            if ((value.ge.MINPKT).and.(value.le.MAXPKT)) then
              myparms(1:1) = kchar(value)
            else
              call tdisp(MINPKT,lim1)
              call tdisp(MAXPKT,lim2)
              report = 'Use buffer size between '//lim1
     !                //' and '//lim2//'.'
              print *, report
            end if
          end if
        else
          print *, ':not a valid set option.'
        end if
      end if

800   continue
      return
      end                   ! subroutine kset

      subroutine sethelp()
      implicit integer(a-z)
      ! Function : This subroutine displays the settable parameters.
      ! Called procedures : none.

      print *, 'Set options are :'
      print *,' '
      print *,'    timeout <decimal value>'
      print *,'    retry <decimal value>'
      print *,'    debug <on | off>'
      print *,'    bufsize <decimal value>'
      print *,'    native <on | off>'
      ! Defer implementation of the SET ECHO option  [lfm 1/85]
      !print *,'    echo <on | off>'

      return
      end                                ! subroutine sethelp


      subroutine khelp()
      ! Function : This is the HELP command interpreter.

      print *,' LANL Cray Kermit Commands :'
      print *,' '
      print *,' server'
      print *,'    (Enter Server mode : all transmission info will'
      print *,'     come from Partner Kermit, as packets.)'
      print *,' s[end] <list of 1-10 file names>'
      print *,'    (Send files to a partner in receive mode)'
      print *,' r[eceive]'
      print *,'    (receive files from non-server partner)'
      print *,' e[xit]'
      print *,'    (exit from non-server Kermit, return to Cray OS)'
      print *,' st[atus]'
      print *,'    (display status of settable Cray Kermit parameters)'
      print *,' set <option> <value>'
      print *,'    (set value of a parameter)'
      print *,' h[elp]'
      print *,'    (display this menu)'
        return
      end

!-cr.pktio-!
      subroutine sendpkt(pindex)
      implicit integer(a-z)
      ! Function : This is the physical packet send routine.  Packets
      !            are sent as messages to the keyboard controller.
      !            If pad or EOL characters have been requested by
      !            the other Kermit,  they are added here.
      ! Called Procedures : strad, unchar, kctl, sycall, logpkt
      character kctl, pad
      character *104 packet(2)
      character *9 myparms, hisparms
      logical debug
      parameter(  wait = 1 )
      parameter( SOH = 01 )

      common /packets/ packet
      common /runparms/ myparms, hisparms
      common /environ/ debug

      dimension beta(5)

      packet(pindex)(1:1) = char(SOH)
      beta(3) = strad(packet(pindex))
      beta(4) = unchar(packet(pindex) (2:2)) + 3    ! pt past chksum
      packet (pindex) (beta(4):beta(4)) = hisparms(5:5)   !append his eol
      npad = unchar(hisparms(3:3))       !  get num pads if any
      if (npad.gt.0)  then               !  he wants pad char prefix
        pad = kctl(hisparms(4:4))        !  uncontrolify - true pad char
        packet(pindex)(npad+1:beta(4)+npad)
     !   = packet(pindex)(1:beta(4))     !  shift data right
        do 10 i=1,npad
          packet(pindex)(i:i) = pad
10      continue
        beta(4) = beta(4) + npad         !  revise length to include pads
      end if
      beta(5) = wait
      call sycall(4l1400,beta)    ! send packet as msg to kbd controller
      if (debug) call logpkt(pindex)     !  show the pkt sent
      !f ( beta(2) .eq. 0 ) then ... what ?
      return
      end                 !  subr sendpkt

      subroutine sendack(pindex,theirseq,ok)
      implicit integer(a-z)
      ! Function :  This is a virtual packet send routine called
      !             in the RECEIVE states.  It invokes SENDPKT and
      !             if ok = 'Y', ACK's pkt no. theirseq, else NAK's it.
      ! Called Procedures :  cksum, sendpkt

      character theirseq, ok, cksum
      character *104 packet(2)
      common /packets/ packet

      packet(pindex)(2:2) = '#'      ! count is coded 3
      packet(pindex) (3:3) = theirseq
      packet(pindex) (4:4) = ok
      packet(pindex)(5:5) = cksum(packet(pindex))
      call sendpkt(pindex)
      return
      end       ! subroutine sendack

      subroutine getpkt(px,status)
      implicit integer(a-z)
      !  Function : This is the packet read routine. Packets are read as
      !             messages from the Keyboard Controller.  When entered,
      !             getpkt suspends itself until arrival of a message
      !             or elapse of timeout interval.  If a message is there
      !             at entry, suspension does not occur (i.e., an
      !             immediate return occurs from the delay sycall).
      !             If awakened by timeout, getpkt returns staus=timeout,
      !             if by msg arrival then staus=good IFF msg is
      !             a correctly checksumed packet,  else status=bad.
      !  Called Procedures :  sycall, logline, unchar, cksum, logpkt,
      !                      tdisp.

      character kchar, cksum, nval*4
      character *9 myparms
      character *104 packet(2)
      logical debug

      common /states/ state, retry, ntries, oldtries, seq,
     !      delay, stdelay
      common /runparms/ myparms
      common /packets/ packet
      common /environ/ debug

      parameter( good = 0, bad = 1, timeout = 2, escape = 3 )
      parameter( abort = 6 )
      parameter( MAXMSG = 104, MINLEN = 5, wait =0, nowait = 1 )
      !  MAXMSG 104 allows up to 96 pkt chars + eol(stripped by ctss),
      !  plus up to 8 pad/noise char prefix.
      parameter( kccmax = 86 )          ! max len of kcc read, alas.
      parameter( soh = 1, esc = 033b )

      dimension alpha(3), beta(5)

      beta(3) = strad(packet(px))          !  get addr of packet
      beta(5) = nowait
10    continue
      alpha(3) = delay
      call sycall(4l3000,alpha)        !  sleep dt or till msg comes
      beta(4) = MAXMSG
      call sycall(4l1500,beta)         !  see which event occurred
      if (beta(2) .ne. 0)  then        !  time elapsed without msg
        status = timeout
        if (debug) call logline('timed out$$')
      else if (beta(4).eq.0) then      !  got lone EOL char - ignore it
        if (debug) call logline('null pkt$$')
        go to 10                         !  go back to sleep
      else if (packet(px)(1:1).eq.char(esc))
     !then                               !  someone hit ESC key
        call logline('escaped$$')
        status = escape
      else                               !  is msg a real packet ?
        if (debug) then
          call tdisp(beta(4),nval)
          call logline('Got '//nval//' msg chars$$')
        end if
        sx = index(packet(px),char(soh)) !  look for SOH in msg
        if ((sx.eq.0).and.(beta(4).lt.MINLEN))
     !  then                             ! Headless blip - treat as noise
          if (debug) call logline('noise pkt ignored$$')
          go to 10
        else if ((sx.eq.0).or.(beta(4).lt.MINLEN)) then
          status = bad                   ! Let it be NAK'ed
          go to 100
        else                             !  it looks like a pkt
30        continue
          nx = index(packet(px)(sx+1:sx+1), char(soh))
          if (nx.ne.0)  then             !  found another SOH
            sx = sx + nx                 !  get its absolute index
            if (sx.le.MAXMSG-MINLEN) then
              go to 30                   !  go see if it's the last one
            else
              status = bad
              go to 100
            end if
          end if
          pklen = unchar(packet(px)(sx+1:sx+1)) + 2
          if (sx .gt. 1)  then           !  need to left-adjust
            packet(px) (1:pklen) = packet(px)(sx:sx+pklen-1)
          end if                         !  if there were pad chars
        end if                                 !  if sx
        if (debug) call logpkt(px)       !  Show their packet
        if (cksum(packet(px)) .eq. packet(px)(pklen:pklen)) then
          status = good
        else
          if (debug) call logline('bad checksum$$')
          status = bad
        end if                           !  if checksum
      end if                             !  if beta(2)
100   return
      end                                     ! subroutine getpkt


      logical function gotack(px,seq)
      implicit integer(a-z)
      !  Function :  This is a virtual packet read routine called from
      !              the SEND state.  Evaluation of GOTACK forces a
      !              call to GETPKT, the physical pkt read rtne.
      !              GOTACK is .true. iff a valid ACK for current pkt
      !              or valid NAK for next is rec'd.  Receipt of good
      !              discard-type ACK for current pkt causes signal
      !              variable to be set to action character in pkt.
      !  Called Procedures :  getpkt, kchar, unchar, logline
      parameter( good=0, bad=1, timeout=2 ) ! getpkt return codes
      character kchar, pseq, ptype, expect, next, signal
      character *104 packet(2)

      common /packets/ packet, signal

      call getpkt(px,status)      !  look for partners response
      if (status.eq.good)  then   !  got a valid pkt
        pcount = unchar(packet(px)(2:2))
        pseq = packet(px)(3:3)
        ptype = packet(px)(4:4)
        expect = kchar(mod(seq,64))
        next = kchar(mod(seq+1,64))
        if (((ptype.eq.'Y').and.(pseq.eq.expect)) .or.
     !      ((ptype.eq.'N').and.(pseq.eq.next)))
     ! then                       !  ACK for this or NAK for next
          gotack = .true.
          !  was it a discard-type ACK ?
          if ((ptype.eq.'Y').and.(pcount.gt.3))  then
            signal = packet(px)(5:5)  !  save discard action field
            call logline('Interrupt request, type '//signal//'$$')
          end if
        else                      !  Good pkt,  wrong type or seq
          gotack = .false.
        end if                    !  If ptype
      else                        !  Bad pkt or timeout
        gotack = .false.
      end if                      !  If getpkt status
      return
      end                         !  logical function gotack

!-cr.receive-!
      subroutine krecv()
      implicit integer(a-z)
      !  Function : RECEIVE state switcher
      !  Called Procedures :  getinit, gethdr, getfile, logline,
      !                       kfclose, kgetime, tdisp.
      parameter( init = 1, hdr = 2, data = 3, feof = 4, complete = 7,
     !            abort = 6 )
      parameter( seconds = 1000000, ms = 1000 )
      character*4 cpr,tpr
      character cmdstr*80, report*40
      logical rpcount, savedcr

      common /states/ state, retry, ntries, oldtries, seq, delay
     !         , stdelay,  tcpu, tio
      common /pkstats/   bptr, bufleft, maxpack, lastbuf
     !                , rpcount, savedcr
      common /strings/ cmdstr, report

      ntries = 0
      delay = stdelay
      state = init
      call kgetime(tcpu,tio)              !  Get initial times

100   if ( state .ne. complete)  then
        if (state .eq. init) then
          call getinit
        else if (state .eq. hdr) then
          call gethdr
        else if (state .eq. data) then
          call getfile
        else if (state .eq. abort) then
          call kfclose                !  make sure recv file closed
          call logline(report)        !  log reported cause of failure
          call errorpkt(report)
          state = complete
        end if                        !  end of non-complete cases
        go to 100
      end if                          !  else state is complete
      call tdisp(seq,tpr)
      call logline('num pkts received = '//tpr//'$$')
      call kgetime(tcx,tix)
      call tdisp((tcx-tcpu)/ms, cpr)
      call tdisp((tix-tio)/seconds,tpr) ! get printable io usage in seconds
      call logline('Transaction time = '//cpr//' cpu ms, '//
     !  tpr//' io sec$$' )
      return
      end                       !  subroutine krecv


      subroutine getinit()
      implicit integer(a-z)
      ! Function :  This routine gets the other Kermit's parameters in
      !             an 'S' packet, checks them,  and ACK's with ours
      !             IFF we can comply with other Kermit's requests.

      parameter( init=1, hdr=2, abort=6)
      parameter( good=0, bad=1, timeout=2, escape=3 )
      parameter( thispkt = 1, nxtpkt = 2 )
      parameter( initry = 20 )           !  allow more tries for S pkt

      character *104 packet(2)
      character cmdstr*80, report*40

      common /states/ state, retry, ntries, oldtries, seq
     !               , delay, stdelay
      common /packets/ packet
      common /strings/ cmdstr, report

      logical nakit, resolve

      if (ntries .ge. initry)  then
        report = 'getinit - too many.'
        state = abort
      else
        ntries = ntries + 1
        nakit = .false.
        if (ntries .eq. 1)  delay = stdelay * 2  !  wait longer for S & F
        call getpkt(thispkt, status)
        if (status .eq. good)  then
          if (packet(thispkt)(4:4) .eq. 'S')  then  ! got a good S pkt
            call decode(thispkt,resolve)         !  decode his parms
            if (resolve) then
              seq = unchar(packet(thispkt)(3:3)) !  synchronize seq nos.
              call encode(nxtpkt,seq,'Y')        !  format our params
              call sendpkt(nxtpkt)               !  send him ours
              state = hdr
              seq = seq + 1
              oldtries = ntries
              ntries = 0
            else
              report = 'cant resolve params.'
              state = abort
            end if                               !  if resolve
          else                                   !  wrong pkt type
            nakit = .true.
          end if
        else if (status.eq.escape) then
          state = abort
          report = 'Host User Escape Request.'
          nakit = .false.
        else                                     !  bad pkt or timeout
          nakit = .true.
        end if                                   !  if status

        if (nakit)  call sendack(ack,' ','N')      !  send NAK

      end if                                     !  if ntries
      return
      end                       !  subroutine       GETINIT

      subroutine gethdr()
      implicit integer(a-z)
      ! Function :  This routine gets an 'F' (header) packet from the
      !             other Kermit, saves file name,  opens a workfile
      !             'kmtfil' to receive the incoming file,  and ACK's
      !             the 'F' pkt.  Workfile name will be switched to header
      !             name when transmission completes.

      parameter( hdr = 2, data = 3, abort = 6, complete = 7 )
      parameter( good = 0, bad = 1, timeout = 2 )
      parameter( thispkt = 1, ack = 2 )
      parameter( buflen = 504 )

      character *104 packet(2)
      character cmdstr*80, report*40
      dimension dkbuf(512)

      common /states/ state, retry, ntries, oldtries, seq
     !              , delay, stdelay
      common /packets/ packet
      common /pkstats/  bptr, bufleft,  maxpack, lastbuf, rpcount, savedcr
      common /strings/ cmdstr, report
      common /environ/ debug, native

      logical ackit, oldfile, kfopen, kfcreate, lastbuf, savedcr
      logical debug, native
      character ptype, kchar
      dimension beta(9)

      if (ntries .ge. retry)  then
        report = 'gethdr - too many.'
        state = abort
      else
        ntries = ntries + 1
        call getpkt(thispkt, status)
        if (status .eq. good)  then
          ptype = packet(thispkt) (4:4)
          if (ptype .eq. 'F')  then
            !  save pkt file name in command string
            namend = unchar(packet(thispkt)(2:2)) + 1
            cmdstr(1:8) = packet(thispkt) (5:namend)
            call stdname(cmdstr(1:8))    !  Convert to std name
            if (kfcreate())  then        !  if opened std recv file
              report = 'Opened std file for:'//cmdstr(1:8)
              call logline(report)
              bptr = 1                   !  initialize buffer ptr
              bufleft = buflen
              savedcr = .false.
            else
              report = 'gethdr - cant open std file.'
              state = abort
              go to 700
            end if
            state = data
            seq = seq + 1
            oldtries = ntries
            ntries = 0
            ackit = .true.
          else if (ptype .eq. 'S')  then
            !  they lost our ACK
            ackit = .false.                !  not a regular ACK
            if (oldtries.lt.retry) then
              call encode(nxtpkt,1,'Y')              !  send it again
              call sendpkt(ack)            !  ACK it again
              oldtries =   oldtries + 1
            else
              report = 'gethdr - aborting after too many S pkts.'
              state = abort
            end if
          else if (ptype .eq. 'Z')  then
            !  lost ACK for previous file on list
            ackit = .true.
            ntries = 0
          else if (ptype .eq. 'B')  then
            state = complete
            ackit = .true.
          else
            report = 'gethdr - aborting on unknown pkt type.'
            state = abort
            ackit = .false.
          end if                                 !  if ptype
          if (ackit)  call sendack(ack,packet(thispkt)(3:3),'Y')
        else if (state .ne. abort) then          !  if bad pkt or timeout
          call sendack(ack,kchar(mod(seq,64)),'N')    ! NAK expected pkt
        end if                                   !  if status
      end if                                     !  if ntries
700   continue
      if (state.gt.hdr)  delay = stdelay  ! restore std delay
      return
      end                               !  subroutine gethdr

      subroutine getfile()
      implicit integer(a-z)
      ! Function :  This routine gets a 'D' (data) packet from the other
      !             Kermit, ACK's it,  and invokes the pkt-unpacking
      !             rtne PUTDATA to buffer received data.  End of file
      !             is detected in this state when a 'Z' pkt arrives.
      !             Discard-type 'Z' pkts are recognized.

      !  send states :
      parameter( hdr = 2, data = 3, abort = 6 )
      !  getpkt status codes :
      parameter( good = 0, bad = 1, timeout = 2 )
      parameter( px = 1, ack = 2 )
      parameter( ok= 0, err = 1 )        !  putdata result codes

      character kchar, ptype, pseq, expect, last
      character cmdstr*80, report*40
      logical puteof

      character *104 packet(2)
      common /states/ state, retry, ntries, oldtries, seq
     !               , delay, stdelay
      common /packets/ packet
      common /strings/ cmdstr, report

      if (ntries .ge. retry) then
        report = 'getfile - too many.'
        state = abort
      else
        ntries = ntries + 1
        call getpkt(px,status)           !  look for expected data pkt
        expect = kchar(mod(seq,64))
        last = kchar(mod(seq-1,64))
        if (status.eq.good) then         !  got a pkt
          pseq = packet(px)(3:3)
          ptype = packet(px)(4:4)
          if (ptype.eq.'D')  then        !  type is Data
            if ((pseq.eq.expect).or.(pseq.eq.last)) then
              call sendack(ack,pseq,'Y')     !  ACK if it's nth or (n-1)st
            end if                           !  if pseq
            if (pseq.eq.expect)  then
              call putdata(px,result)        !  store data from nth pkt
              if (result.ne.ok)  then
                report = 'file write error.'
                state = abort
              else
                seq = seq + 1
                oldtries = ntries
                ntries = 0
              end if
            end if                           !  if pseq in 'D' pkt
          else if (ptype.eq.'Z')  then       !  received eof
            if(unchar(packet(px)(2:2)).eq.3) then  ! Normal EOF pkt
              ! evaluate puteof to terminate file, switch name
              if(.not.(puteof(cmdstr(1:8))))  then
                report = 'can''t save file.'
                state = abort
              end if
            else if (packet(px)(5:5).eq.'D') then
              call kfclose()            !  This file to be Discarded.
              call logline('Incoming copy discarded by request$$')
            end if
            if (state.ne.abort) then
              state = hdr
              seq = seq + 1
              ntries = 0
              call sendack(ack,pseq,'Y')
            end if
          else if (ptype .eq.'F') then   !  they lost our ACK
            call sendack(ack,pseq,'Y')   !  ACK again
            ntries = 0
          else                           !  probably 'E' or 'B' pkt
           state = abort
           if(ptype.eq.'E') call logpkt(px)
          end if                         !  if ptype
        else                             !  timeout or bad pkt
          call sendack(ack,expect,'N')   !  NAK it
        end if                             !  if status
      end if                             !  if ntries
      return
      end                                        !  subroutine getfile


!-cr.send-!
      subroutine ktrans()
      implicit integer(a-z)
      ! Function : State-switcher for shipping files out.
      !            Called Procedures change the state. Complete state
      !            occurs after sendeof finds arg list empty, or after
      !            a called procedure signals abort state.
      ! Called Procedures : sendinit, sendhdr, sendfile, sendeof,
      !                     sendbrk, errorpkt, logline, kfclose, kgetime,
      !                     tdisp
      parameter( init = 1, hdr = 2, data = 3, feof = 4, break = 5,
     !           abort = 6, complete = 7 )
      parameter( seconds = 1000000, ms = 1000)
      character cmdstr*80, report*40
      logical lastbuf, savedcr

      common /states/ state, retry, ntries, oldtries, seq
     !                 , delay, stdelay, tcpu, tio
      common /pkstats/   bptr, bufhold, maxpack, lastbuf
     !                 , rpcount, savedcr
      common /strings/ cmdstr, report

      character*4 cpr, tpr
      character *4 dval

      ntries = 0
      delay = stdelay
      call kgetime(tcpu,tio)            !  get initial trans. times
      state = init

100   if ( state .ne. complete ) then
        if (state .eq. init) then
          call sendinit
        else if (state .eq. hdr) then
          call sendhdr
        else if (state .eq. data) then
          call sendfile
        else if (state .eq. feof) then
          call sendeof
        else if (state .eq. break) then
          call sendbrk
        else if (state .eq. abort) then
          call errorpkt(report)
          call logline(report)
          call kfclose()         ! close send file
          state = complete
        else
          report = 'unrecognized state.'
          state = abort
        end if
        go to 100
      end if                      !  if not complete

      call tdisp(seq+1,tpr)
      call logline('Number of packets sent = '//tpr//'$$')
      !  log elapsed times for trans.
      call kgetime(tcx,tix)            !  get times used till now
      call tdisp((tcx-tcpu)/ms,cpr)    !  printable cpu time in ms
      call tdisp((tix-tio)/seconds,tpr)
      call logline('Tr time : cpu='//cpr
     !     //' ms, io='//tpr//' sec$$')

      return
      end                        ! subroutine ktrans


      subroutine sendinit()
      implicit integer(a-z)
      !  Function :  This routine sends an 'S' pkt with our params
      !              and looks for partner's params in his ACK.
      !              If valid ACK is rec'd and we can comply with
      !              partner's specs., then state <== hdr;  else if
      !              we cant resolve params or we dont receive ACK in
      !              requisite num. tries, state <== abort.
      !  Called Procedures :  encode,sendpkt, getpkt, decode

      parameter( hdr = 2, break = 5, abort = 6 )
      parameter( good = 0, bad = 1, timeout = 2, escape = 3 )
      parameter( thispkt = 1, nxtpkt = 2 )
      parameter( initry = 20 )           !  allow more tries for S pkt

      logical resolve
      character ptype, kchar
      character cmdstr*80, report*40
      character *104 packet(2)
      character *4 dval

      common /states/ state, retry, ntries, oldtries, seq,
     !               delay, stdelay
      common /globals/ runtype, nargs, args(10,2), thisarg
      common /strings/ cmdstr, report
      common/packets/packet

       if (ntries .ge. initry) then
        delay = stdelay                      !  restore std delay
        report = 'can''t get ACK for S pkt.'
        state = abort
      else
        ntries = ntries + 1
        if (ntries .eq. 1)  then             ! if 1st try, prepare
          delay = delay * 2                  !  allow longer for S & F
          call encode(thispkt,0,'S')         !  make an S pkt
        end if
        call sendpkt(thispkt)                !  send our S pkt
        call getpkt(nxtpkt,status)           !  look for his ACK
        if (status .eq. good)  then          !  got a good pkt
          if ((packet(nxtpkt) (4:4) .eq. 'Y') .and.
     !     (packet(nxtpkt) (3:3) .eq. ' '))  then
            call decode(nxtpkt,resolve)      !  decode his params
            if (resolve) then
              state = hdr
            else
              state = abort
              report = 'cant resolve initial parameters.'
            end if
          else if((packet(nxtpkt)(4:4).eq.'N')
     !         .and.(packet(nxtpkt)(3:3).eq.'!'))
     !    then                           !  we lost their previous ACK
            state = hdr
          end if
          if (state.eq.hdr) then
            seq = 1
            ntries = 0
            thisarg = 1
          end if                         !  if state
        else if (status.eq.escape) then
          state = abort
          report = 'User Escape Request.'
        end if                           !  if status - else dont change
      end if           !  if ntries ok
      return
      end     ! subroutine sendinit

      subroutine sendhdr()
      implicit integer(a-z)
      !  Function :  This routine sends a 'F' (file header) pkt,
      !              and accepts its ACK from the other Kermit.
      !              The send file is opened and buffers initialized
      !              before the first attempt to send the pkt.
      !              If a valid ACK is received in the requisite number
      !              of tries, state <== data, else state <== abort.
      !              Discard-type ACK's are recognized in this state.
      !  Called Procedures : logline, kfopen, errorpkt, makehdr,
      !                      unchar, sendpkt, gotack

      character *104 packet(2)
      character cmdstr*80, report*40
      character *8 fname
      character *9 myparms,hisparms
      character kchar, signal
      logical lastbuf

      common /runparms/ myparms, hisparms
      common /states/ state, retry, ntries, oldtries, seq,
     !               delay, stdelay
      common /globals/ runtype, nargs, args(10,2), thisarg
      common /strings/ cmdstr, report
      common /packets/ packet, signal
      common /pkstats/ bptr, bufhold,  maxpack, lastbuf, rpcount

      parameter( hdr = 2, data = 3,  abort = 6 )
      parameter( thispkt = 1, ack = 2 )
      logical kfopen, gotack

      if (ntries .ge. retry) then
        report = 'can''t get ACK for F pkt.'
        state = abort
      else
        ntries = ntries + 1
        if (ntries .eq. 1) then
          !  Do file xfer initialization once,
          !  before sending 1st 'F' pkt :
          fname = cmdstr (args(thisarg,1):args(thisarg,2))
          if (.not.(kfopen(fname)))  then
            report = 'cant open:' // fname // '.'
            state = abort
            go to 800
          else
            report = 'Opened send file: '//fname
            call logline(report)
            call makehdr(thispkt,seq)    !  prepare the 'F' pkt
            bufhold = 0                  !  declare char buffer empty
            bptr = 1
            maxpack = unchar(hisparms(1:1)) + 1  !  last data pos
            if (myparms(3:3).ne.' ') then
                ! Site Dependency : use pkt length 2 less than Partner's
                ! bufsize, lest echoback of his pad & EOL chars overflow
                ! his input buffer
                maxpack = maxpack - 2
            end if
            signal = ' '                 !  set discard signal off
            lastbuf = .false.               !  set EOF indicator off
            rpcount = 0                 !  initialize repeat count
          end if
        end if                      !  if 1st try
        call sendpkt(thispkt)                     !  send an F pkt
        if (gotack(ack,seq)) then       !  if partner acknowledges
          seq = seq + 1
          ntries = 0
          if (signal.eq.' ')  then      !  no complications
            state = data                !  hdr ACKed, go to data state
          else                          !  The ACK was a discard signal
            state = feof                !  Go directly to EOF state
          end if                          !  If signal
        end if                            !  If gotack - else no change
      end if                     !  if ntries
800   continue
      if (state .ne. hdr)  delay = stdelay         !  restore std. delay
      return
      end     ! subroutine sendhdr

      subroutine sendfile()
      implicit integer(a-z)
      !  Function :  This routine sends a 'D' (data) packet and
      !              looks for an ACK.  End of file is detected
      !              upon report from MAKEDATA, the data packet
      !              preparation rtne.  Discard-type ACK's are
      !              recognized in this state.
      !  Called Procedures : makedata, sendpkt, gotack

      parameter( thispkt = 1, ack = 2 )
      parameter( data = 3, feof = 4, abort = 6 )
      parameter( ok = 0, lastpkt = 1, nopkt=3, err = 4 )
      logical gotack

      character *104 packet(2)
      character signal
      character kchar, cksum
      character cmdstr*80, report*40

      common /states/ state, retry, ntries, oldtries, seq
     !              , delay, stdelay
      common /packets/ packet, signal
      common /strings/ cmdstr, report

      if (ntries.ge.retry)  then
        report = 'can''t get ACK for data pkt.'
        state = abort
      else
        ntries = ntries + 1
        if (ntries.eq.1) then            !  set up packet 1st time
          call makedata(seq,result)      !  get packetfull
          if (result.eq.nopkt) then
            state = feof
            ntries = 0
            go to 400
          else if (result.eq.err) then
            state = abort
            go to 400
          end if                         !  if nthg to send
        end if                           !  if 1st try
        call sendpkt(thispkt)            !  send data packet(n)
        if (gotack(ack,seq))  then       !  if partner acknowledges
          seq = seq + 1
          ntries = 0
          if ((signal.ne.' ').or.(result.eq.lastpkt)) then
            state = feof
          end if                          !  if signal - else dont change
        end if                            !  if gotack - else dont change
      end if                             !  if ntries
400   continue
      return
      end    ! subroutine sendfile

      subroutine sendeof()
      implicit integer(a-z)
      !  Function :  Sends a 'Z' pkt indicating end-of-file.
      !              If this state was entered in response to an
      !              interrupt-request (other Kermit's discard-type
      !              ACK for a previous pkt) or if no more files to
      !              send, then state <== break,  else state <== hdr.
      !              Discard-type ACK's are recognized in this state.
      !  Called Procedures :  logline, sendpkt, gotack, kfclose

      parameter( hdr = 2, break = 5, abort = 6, complete = 7 )
      parameter( thispkt=1, ack=2 )
      parameter( good = 0, bad = 1, timeout = 2 )

      logical gotack, debug
      character *104 packet(2)
      character signal
      character cmdstr*80, report*40

      common /states/ state, retry, ntries, oldtries, seq
     !               , delay, stdelay

      common /globals/ runtype, nargs, args(10,2), thisarg
      common /packets/ packet, signal
      common /strings/ cmdstr, report
      common /environ/ debug

      if (ntries .ge. retry) then
        report = 'can''t get ACK for Z pkt.'
        state = abort
      else
        ntries = ntries + 1
        if (ntries .eq. 1)  call makeof(thispkt,seq)
        call sendpkt(thispkt)
        if (gotack(ack,seq))  then
          ntries = 0
          call kfclose     !  close the file just sent
          if (debug)  call logline('close send file$$')
          seq = seq + 1
          if ((thisarg .lt. nargs).and.(signal.ne.'Z'))  then
            thisarg = thisarg + 1    !  index next fname
            state = hdr
          else                   !  no more files to send
            state = break
          end if
        end if                   !  if gotack
      end if
      return
      end     ! subroutine sendeof

      subroutine sendbrk()
      implicit integer(a-z)
      !  Function :  Sends a 'B' (break) packet indicating completion
      !              of current transmission.  If valid ACK is received
      !              state <== complete, else state <== abort.
      !  Called Procedures :  kchar, sendpkt, getpkt

      character kchar, myseq
      character *104 packet(2)
      character cmdstr*80, report*40

      common /states/ state, retry, ntries, oldtries, seq
     !              , delay, stdelay
      common /packets/ packet
      common /strings/ cmdstr, report

      parameter( abort = 6, complete = 7 )
      parameter( thispkt = 1, ack = 2)
      parameter( good = 0, bad = 1, timeout = 2 )

      if (ntries .eq. retry) then
        report = 'can''t get ACK for Break pkt.'
        state = abort
      else
        ntries = ntries + 1
        if (ntries .eq. 1)  call makebrk(thispkt,seq)
        call sendpkt(thispkt)
        call getpkt(ack,status)
        if (status .eq. good)  then
          myseq = kchar(mod(seq,64))
          if ((packet(ack) (4:4) .eq. 'Y') .and.
     !        (packet(ack) (3:3) .eq. myseq))
     !    then
            state = complete
          end if         !  else NAK, wrong ACK - dont change
        end if           ! if status ...  else dont change state
      end if
      return
      end      ! subroutine sendbrk


      subroutine encode(pindex, seq,type)
      implicit integer(a-z)
      ! Function : puts current cray parameters into an 'S' packet
      !             (if called in SEND state) or a 'Y' packet
      !             (if called from RECEIVE state).
      ! Called Procedures : kchar, cksum
      character kchar, cksum, type
      character *104 packet(2)
      character *9 myparms, hisparms

      common /packets/ packet
      common /runparms/ myparms, hisparms

      parameter( soh = 1, cr = 13, numparm = 9 )

      packet(pindex) (2:2) = kchar( numparm + 3 )  ! set count
      packet(pindex) (3:3) = kchar(mod(seq,64))
      packet(pindex) (4:4) = type               ! set type
      packet(pindex) (5:13) = myparms(1:9)
      packet(pindex)(14:14) = cksum(packet(pindex))

      return
      end      ! subroutine encode

      subroutine makehdr(pindex,seq)
      implicit integer(a-z)
      ! Function : Makes an 'F' (header) packet,  getting file name
      !            from user's input line, saved in cmdstr.
      ! Called Procedures : kchar, cksum

      character *80 cmdstr
      character *104 packet(2)
      common /strings/ cmdstr
      common /globals/ rtype,n, args(10,2), thisarg
      common /packets/ packet
      character kchar,cksum

      arglen = args(thisarg,2) - args(thisarg,1) + 1
      packet (pindex) (2:2) = kchar(arglen+3)
      packet (pindex) (3:3) = kchar(mod(seq,64))
      packet (pindex) (4:4) = 'F'
      packet(pindex)(5:4+arglen) =
     !         cmdstr (args(thisarg,1) : args(thisarg,2))
      packet(pindex) (5+arglen:5+arglen) = cksum(packet(pindex))

      return
      end     ! subroutine makehdr

      subroutine makeof(pindex,seq)
      implicit integer(a-z)
      ! Function : If signal is the normal blank, makes a std
      !            'Z' pkt indicating normal EOF,  else
      !            makes a discard-type 'Z' packet.
      ! Called Procedures : kchar, cksum

      character *104 packet(2)
      character signal, cx
      common /packets/ packet, signal
      character kchar,cksum

      if (signal.eq.' ') then           ! Normal EOF - no data field.
        packet (pindex) (2:2) = kchar(3)
      else                              ! Interrupt signal - need data fld
        packet(pindex)(2:2) = kchar(4)
      end if
      packet (pindex) (3:3) = kchar(mod(seq,64))
      packet (pindex) (4:4) = 'Z'
      if (signal.eq.' ') then           ! It's a normal EOF
        packet(pindex)(5:5) = cksum(packet(pindex))
      else                              ! We've received interrupt signal
        packet(pindex)(5:5) = 'D'       ! Tell them to close and Discard
        packet(pindex)(6:6) = cksum(packet(pindex))
      end if

      return
      end    ! subroutine makeof

      subroutine makebrk(pindex,seq)
      implicit integer(a-z)
      character *104 packet(2)
      common /packets/ packet
      character kchar,cksum

      packet (pindex) (2:2) = kchar(3)
      packet (pindex) (3:3) = kchar(mod(seq,64))
      packet (pindex) (4:4) = 'B'
      packet(pindex)(5:5) = cksum(packet(pindex))

      return
      end     ! subroutine makebrk

      subroutine decode(pindex,ok)
      implicit integer(a-z)
      ! Function : Saves partner's params & resolves with ours.
      !            Returns ok = .true. iff we can comply with
      !            partner's parameters, else ok = .false.
      ! Called Procedures : kchar, unchar, logline

      logical ok, debug, native, quote8, repeat
      character kchar
      character *104 packet(2)
      character cmdstr*80, report*40
      character *9 myparms, hisparms, default
      common /runparms/ myparms, hisparms, default
      common /environ/ debug, native, quote8, repeat
      common /packets/ packet
      common /strings/ cmdstr, report

      hislast = unchar(packet(pindex)(2:2)) + 1   ! index last data char
      if (hislast .gt. 4) then
        if (debug) then
          report = 'Partner''s params received: '//
     !    packet(pindex)(5:hislast) //'$$'
          call logline(report)
        end if
        do 50 i=5, hislast
          j = i-4
          if (packet(pindex)(i:i) .ne. ' ') then
            hisparms(j:j) = packet(pindex)(i:i)  ! save char he asks for
          else
            hisparms(j:j) = default(j:j)
          end if
50      continue
      end if
      !  Use standard defaults for his omissions :
      if (hislast .lt. 13)  then     ! if he didnt specify all
        hisparms(hislast-3:9) = default(hislast-3:9)
      end if
      ok = .true.                        !  start optimistically
      !  Treat Partner's BUFSIZE param as max count he wants :
      hisbuf = unchar(hisparms(1:1)) + 2 ! packet length he wants
      hisnpad = unchar(hisparms(3:3))    ! no. pad chars he wants
      ! now make sure we agree on things ..
      if ((hisparms(7:7).eq.'&').or.(hisparms(7:7).eq.'Y'))
     !then
        quote8 = .true.
      else
        quote8 = .false.
      end if
      hisparms(8:8) = '1'          !  I only do 1-char checks
      if ((hisparms(9:9).eq.'~').and.(myparms(9:9).eq.'~')) then
        repeat = .true.            !  We both agree to do 8th bits
      else
        repeat = .false.
      end if
      if (hisbuf .lt. 6) then       !  call that a packet?
        ok = .false.
      else if (hisbuf+hisnpad .gt. 104) then
        ok = .false.
      end if
      ! decode his eol
      hisparms(5:5) = char(unchar(hisparms(5:5)))  ! save true eol char
      return
      end       ! subroutine decode

      subroutine errorpkt(msg)
      implicit integer(a-z)
      ! Function : formats an error packet w/msg arg text
      ! Called Procedures : kchar, cksum
      parameter (thispkt = 1, soh=01 )
      character *40 msg
      character *104 packet(2)
      character kchar, cksum
      common /states/ state, retry, ntries, oldtries, seq
      common /packets/ packet

      k = index(msg,'.')      ! look for a delimiter
      if (k.eq.0)  k = 40        ! if none - xfer max
      packet(thispkt)(2:2) = kchar(k+3)
      packet(thispkt)(3:3) = ' '           ! no seq.
      packet(thispkt)(4:4) = 'E'           ! type is Error
      packet(thispkt)(5:4+k) = msg(1:k)
      packet(thispkt)(5+k:5+k) = cksum(packet(thispkt))
      call sendpkt(thispkt)
      return
      end      ! subroutine errorpkt

!-cr.stdutils-!
      character function kchar(n)
      ! maps an integer n=(0,136)octal onto the nth character
      ! in the ascii printable range : 40,176 octal

        kchar = char( n + 040b )
        return
      end

      character function kctl(n)
      ! Function : maps true ctl char (ascii 000 - 037) onto unique
      !            printable representation.
      character n

      kctl = char( ichar(n) .xor. 100b)
      return
      end

      integer function unchar(n)
      ! Function : maps print char onto decoded octal
      character n

        unchar = ichar(n) - 40b
      return
      end

      character function cksum(cpkt)
      implicit integer(a-z)
      !Function : computes Type 1 checksum for argument pkt
      ! Called Rtnes : unchar, kchar

      character kchar
      character *104 cpkt

      count = unchar(cpkt(2:2))       ! decode to true count
      sum = 0        ! initialize
      do 100 i=2,count + 1
        sum = sum + ichar(cpkt(i:i))  ! add coded char value
100   continue
      sum = (sum + shiftr(sum .and. 300b , 6)) .and. 077b
      cksum = kchar(sum)
      return
      end

      integer function strad(x)
      ! returns word addr of string argument
      parameter( strmask = 77700000000000b )

      itemp = loc(x)
      strad = ( itemp .and. strmask ) .xor. itemp
      return
      end

      logical function member(word,pattern)
      implicit integer(a-z)
      character word*8, pattern*1

      if (index(word,pattern).eq.0)  then
        member = .false.
      else
        member = .true.
      end if
      return
      end                               !  logical fn member

      subroutine stdname(string)
      implicit integer(a-z)
      !  Function : Converts incoming file name from uppercase to lower,
      !             and if there is a trailing dot, but no suffix, blanks
      !             out the dot.
      character*8 string
      parameter(dot=056b)

      do 10 i=1,8
        cval = ichar(string(i:i))
        if ((cval.ge.101b).and.(cval.le.132b)) then
          string(i:i) = char(cval+40b)   !  Convert to lower case
        end if
10    continue
      dx = index(string(1:8),char(dot))
      if (dx.gt.0) then                  !  file name has a dot
        !  See if the dot is followed by a Suffix :
        if (dx.eq.8) then
          string(dx:dx) = ' '            !  blank out the dot
        else if (string(dx+1:dx+1).eq.' ') then
          string(dx:dx) = ' '
        end if                           !  if no suffix follows the dot
        ! else leave dot and suffix in file name
      end if                             !  if file name has embedded dot
      return
      end


      subroutine tdisp(value,pval)
      implicit integer(a-z)
      ! Function : converts integer value to Ascii equivalent
      character*4 pval

      if (value.gt.9999)  then
        pval(1:4) = ' big'
      else
        p2 = value/10
        p3 = p2/10
        p4 = p3/10
        pval(1:4) = char(p4+48)//char(mod(p3,10)+48) //
     !               char(mod(mod(p2,100),10)+48) //
     !               char(mod(mod(mod(value,1000),100),10)+48)
      end if
70    return
      end                                !  subroutine tdisp

      subroutine undisp(str,val,code)
      implicit integer(a-z)
      ! Function : converts 2-digit Ascii string to numeric value
      character *2 str
      logical code

      if ((str(1:1).ge.'0').and.(str(1:1).le.'9').and.
     !    (str(2:2).ge.'0').and.(str(2:2).le.'9')) then
        val = 10*(ichar(str(1:1))-48) + ichar(str(2:2)) - 48
        code = .true.
      else
        val = 0
        code = .false.
      end if
      return
      end                                  ! subroutine undisp

      subroutine logger
      implicit integer(a-z)
      character *104 packet(2)
      character *80 logit
      logical status, fexist, fopen
      common /units/ logioc, fioc
      common /packets/ packet

      entry initlog(status)

      inquire(iostat=ios,exist=fexist,opened=fopen,file='kmtlog')
      if ((ios.ne.0).or.( fexist.and.fopen)) then
        status = .false.
        go to 100
      else
        if (fexist) then
          call destroy(logioc,'kmtlog',0,dstat)
          if (dstat.ne.0) then
            status = .false.
            go to 100
          end if
        end if
        open(unit=logioc,iostat=ios,file='kmtlog',status='new')
        if (ios.ne.0) then
          status = .false.
          go to 100
        else
          status = .true.
        end if
      end if
      go to 100

      entry logline(logit)
      ! Function : writes calling string argument onto std logfile.
      !            Uses 1st 40 chars if no '$$' terminator in string.


      k = index(logit,'$')
      if ((k.eq.0).or.(logit(k+1:k+1).ne.'$'))
     !then                               ! no terminator, use default
        k = 40
      else
        k = k-1
      end if
      write(unit=logioc,fmt=*) logit(1:k)
      go to 100

      entry logpkt(px)
      ! Function : writes the packet indexed in calling argument
      !            onto std logfile.  This routine is called from
      !            the SENDPKT and GETPKT routines if the debug
      !            option is on.

      k = unchar(packet(px)(2:2)) + 2    ! number of chars. to log
      write(unit=logioc,fmt=*) packet(px)(1:k)
      go to 100

      entry endlog

      close(unit=logioc,iostat=ios,status='keep')

100   continue
      return
      end                                !  subroutine logger